perm filename NEWMRK.OLD[NEW,LCS]1 blob
sn#509262 filedate 1980-05-07 generic text, type T, neo UTF8
C************ NEWMRK, DOIT, MORMRK, DASHES, CPYALL **************
SUBROUTINE NEWMRK(VX)
DIMENSION VX(1)
COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
MX=0
C MX IS FLAG FOR LINE TOO LONG IN NEW FORMAT
J=0
MM=0
10 JJ=0
NN=0
N2=0
1 J=J+1
IF(J.GT.72)GO TO 20
C JUMP IF DONE
M=INP(J)
CURRENT CHARACTER
IF(M.EQ.'-')GO TO 21
C '-' NEEDED FOR "C-" (DECRESC. SIGN)
IF(M.LT.'A'.OR.M.GT.'Z')GO TO 2
C JUMP IF A LETTER IS NOT FOUND
21 JJ=JJ+1
N(JJ)=M
GO TO 1
2 IF(M.EQ.' ')GO TO 1
5 NN=NN+1
JN(NN)=M
C SAVE THE NUMBER CHARS.
6 J=J+1
M=INP(J)
IF(M.GE.'0'.AND.M.LE.'9')GO TO 5
IF(M.EQ.'.')GO TO 5
IF(M.NE.':')GO TO 22
M='-'
C NEG. N2 WILL =TOTAL OF ITEMS STARTING WITH N1( /S 12:3/=/S 12-14/)
NN=NN+1
JN(NN)=' '
GO TO 5
22 IF(M.EQ.' ')GO TO 6
IF(M.NE.'-')GO TO 7
C NOW A SEQUENCE OF ITEMS
M=' '
GO TO 5
7 IF(M.NE.',')GO TO 8
C NOW A SINGLE ITEM
CALL DOIT
NN=0
C ITEM OR ITEMS NOW FINISHED
GO TO 6
8 IF(M.NE.'/')GO TO 11
CALL DOIT
GO TO 10
11 IF(M.NE.';'.AND.M.NE.'*')GO TO 6
C JUMP IF UNKNOWN CHAR.
CALL DOIT
KN(MM)=M
IF(MM.LE.71)GO TO 20
C SKIP IF REVISED LINE NOT TOO LONG
MZ=MM
DO 201 MM=71,1,-1
201 IF(KN(MM).EQ.'/')GO TO 202
202 MX=MM+1
C POINTS TO START OF REMAINDER OF TOO-LONG LINE
INP(72)=0
CC20 DO 12 K=1,MM
CC12 INP(K)=KN(K)
CC DO 13 K=MM+1,J
CC13 INP(K)=' '
CCC NOW GO FIX UP THE VX ARRAY.
CC CALL RREAD(INP,VX)
CC DO 23 K=1,50
CC X=VX(K)
CC IF(X.GT.0)Z=X
CCC SAVE THE LAST POSITIVE NUM.
CC IF(X.LT.0)VX(K)=-X+Z-1.
CCC /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
CC23 CONTINUE
CC999 NNN=VX(1)
20 CALL MORMRK(1,MM,VX)
END
SUBROUTINE DOIT
COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JJ,NN,MM
IF(N(1).NE.'C'.AND.N(1).NE.'O')GO TO 3
CATCHES /C 5-7/C- 11.2-13.5/O 1-21/ ETC.
IF(N2.EQ.'R')GO TO 3
C JUMP IF "CR" FOR WORD "CRESC."
DO 4 K=1,NN
MM=MM+1
JX=JN(K)
KN(MM)=JX
4 IF(JX.EQ.' ')GO TO 5
C FIRST NUMBER COMPLETED
5 DO 6 JX=1,JJ
MM=MM+1
6 KN(MM)=N(JX)
CODE LETTER INSERTED
MM=MM+1
KN(MM)=' '
DO 7 JX=K+1,NN
C NOW PUT IN LAST NUMBER
MM=MM+1
7 KN(MM)=JN(JX)
GO TO 8
3 DO 1 K=1,NN
MM=MM+1
1 KN(MM)=JN(K)
MM=MM+1
KN(MM)=' '
DO 2 K=1,JJ
MM=MM+1
2 KN(MM)=N(K)
C NOW PUT IN THE CODE WORD
8 MM=MM+1
KN(MM)='/'
CLOSE OFF THE ITEM
END
CC SUBROUTINE MORMRK(VX)
SUBROUTINE MORMRK(MA,MB,VX)
DIMENSION VX(1)
COMMON /DPY/ST(3690),N(1),N2,N3,JN(72),KN(172),RX(50),JO,NN,MM
1 /SC/A,B,C,D,E,NNN /ALF/INP(1) /MX/MX,MZ
CC K=0
MM=0
C GET THE REST OF A TOO-LONG LINE
DO 1 K=MA,MB
CC DO 1 J=MX,MZ
MM=MM+1
CC K=K+1
1 INP(MM)=KN(K)
CC1 INP(K)=KN(J)
CC MM=K
DO 13 K=MM+1,72
13 INP(K)=' '
IF(INP(MM).EQ.'*')INP(72)='*'
C LINE ENDS WITH * OR ;
C NOW GO FIX UP THE VX ARRAY.
3 CALL RREAD(INP,VX)
DO 23 K=1,50
X=VX(K)
IF(X.GT.0)Z=X
C SAVE THE LAST POSITIVE NUM.
IF(X.LT.0)VX(K)=-X+Z-1.
C /S 17:5/=/S 17-21/ I.E. 5 NOTES STACCATO, STARTING WITH 17
23 CONTINUE
999 NNN=VX(1)
CC MX=0
END
SUBROUTINE DASHES(RJQ)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /XRN/RN(3000)
1 /PTR/KWDS(350) /DL/K22
1 /LIMIT/LIMIT,ITEM /STF/RSTFAC(0/7),RSTJ2
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
1 ,(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
2 RJQ(5)),(R3,RJQ(1))
4,(R11,RJQ(9)),(R10,RJQ(8)),(R8,RJQ(6)),(R9,RJQ(7))
C FIND CLOSEST WORD TO LFT AND RIGHT OF R3
B=9999.0
A=-B
DO 1 K=1,ITEM
C GETS CODE NUM. J=PTR TO THAT ITEM.
J=KWDS(K)
5 IF(RN(J+1).NE.16)GO TO 1
C FOUND WORD
IF(RN(J+2).NE.R2)GO TO 1
C NOW ON THIS STAFF
7 RR3=RN(J+3)
IF(RR3.GT.R3)GO TO 3
IF(RR3.LE.A)GO TO 1
A=RR3
LFT=J
C A WILL BE POS. OF FRONT OF LEFT GROUP. LFT IS PNTR.
GO TO 1
3 IF(RR3.GE.B)GO TO 1
B=RR3
JRT=J
1 CONTINUE
C WON'T WORK WITH OVERLAPPING WORDS!!!!
2 R=RN(LFT+5)*RSTJ2
C R=REAL SIZE FACTOR FOR SPACE RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
R3=R*(RN(LFT+9)-0.5)+A
R6=B-R*3.32
IF(R3.LT.0)R3=1.
IF(R6.GT.201)R6=201.
C 3.32 IS BASIC WIDTH OF MOST LETTERS
4 R4=RN(LFT+4)+1.0-RN(LFT+5)*0.5*RSTJ2
C SET HEIGHT OF DASH CONSIDERS LETTER SIZE AND STAFF SIZE
R5=R4
END
SUBROUTINE CPYALL
C COPIES ALL OF ONE CODE NUM. FROM ONE STAFF TO ALL OTHER ACTIVE STAVES.
COMMON /LIMIT/LIMIT,ITEM,L,I /PTR/KWDS(1) /POSI/S(8),JJ2
COMMON R2,J,K,N,RJQ(3),R6,RJ(16),NO,JQ(10),NN,LL /XRN/RN(1)
JJ2=ITEM+1
J=ITEM
C NOW FIND WHICH STAVES CURRENTLY ACTIVE
DO 1 K=0,7
1 JQ(K)=0
DO 2 K=1,J
L=KWDS(K)
2 JQ(IFIX(RN(L+2)))=-1
JQ(IFIX(R2))=0
C BUT OMIT SOURCE STAFF
DO 3 K=1,J
L=KWDS(K)
IF(RTLINE(L).LT.0)GO TO 3
C ON RIGHT LINE?
IF(OUTLIM(L,3).LT.0)GO TO 3
C WITHIN GIVEN LFT AND RT LIMITS?
9 IF(RN(L+1).NE.R6)GO TO 3
C FOUND A SOURCE ITEM (CODE# IN R11). NOW PUT IT ON ALL OTHER STAVES.
7 NN=RN(L)+3
C NUMBER OF NEW WORDS ADDED TO ARRAY
DO 8 N=0,7
IF(JQ(N).EQ.0)GO TO 8
4 CALL LOOP(0,NN,1,I,L,RN)
5 ITEM=ITEM+1
LL=KWDS(ITEM)
RN(LL+2)=N
C PUT IN CORRECT STAFF NUM.
6 I=I+NN
C UPDATE XRN ARRAY COUNTER AND POINTER ARRAY.
KWDS(ITEM+1)=I
8 CONTINUE
3 CONTINUE
CC JJ2=ITEM+1
END